home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / System / FrmAnts.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-07  |  3.2 KB  |  120 lines
  1. unit FrmAnts;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TAntsNest = class(TForm)
  11.     Timer1: TTimer;
  12.     Panel1: TPanel;
  13.     Panel2: TPanel;
  14.     Panel3: TPanel;
  15.     Panel4: TPanel;
  16.     Panel5: TPanel;
  17.     Panel6: TPanel;
  18.     Panel7: TPanel;
  19.     procedure Timer1Timer(Sender: TObject);
  20.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  21.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  22.     procedure FormMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  23.   private
  24.     Anchor: TPoint;
  25.     HotRect: TRect;
  26.     DashMask: Byte;
  27.     procedure DrawHotRect;
  28.     procedure SetHotRect (X1, Y1, X2, Y2: Integer);
  29.   public
  30.     { Public declarations }
  31.   end;
  32.  
  33. var
  34.   AntsNest: TAntsNest;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. procedure LineDDAProc (X, Y: Integer; Self: TAntsNest); stdcall;
  41. const
  42.     DotPattern: Byte = $a0;
  43. var
  44.     C: Integer;
  45. begin
  46.     with Self do begin
  47.         DashMask := DashMask shl 1;
  48.         if DashMask = 0 then DashMask := 1;
  49.         if (DashMask and DotPattern) <> 0 then C := Color else C := clBlack;
  50.         SetPixel (Canvas.Handle, X, Y, ColorToRGB (C));
  51.     end;
  52. end;
  53.  
  54. procedure TAntsNest.FormMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  55. begin
  56.     SetHotRect (X, Y, X, Y);
  57. end;
  58.  
  59. procedure TAntsNest.FormMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer);
  60. begin
  61.     if ssLeft in Shift then begin
  62.         SetHotRect (Anchor.x, Anchor.y, X, Y);
  63.         DrawHotRect;
  64.     end;
  65. end;
  66.  
  67. procedure TAntsNest.FormMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  68. var
  69.     R: TRect;
  70.     Idx : Integer;
  71. begin
  72.     for Idx := 0 to ControlCount - 1 do
  73.         if Controls [Idx] is TPanel then with Controls [Idx] as TPanel do
  74.             if IntersectRect (R, BoundsRect, HotRect) then Color := clYellow else Color := clBtnFace;
  75. end;
  76.  
  77. procedure TAntsNest.SetHotRect (X1, Y1, X2, Y2: Integer);
  78. var
  79.     Temp: Integer;
  80. begin
  81.     // Erase previous rectangle, if any
  82.     if not IsRectEmpty (HotRect) then begin
  83.         InflateRect (HotRect, 1, 1);
  84.         InvalidateRect (Handle, @HotRect, True);
  85.         InflateRect (HotRect, -2, -2);
  86.         ValidateRect (Handle, @HotRect);
  87.         UpdateWindow (Handle);
  88.     end;  
  89.  
  90.     Anchor.x := X1;  Anchor.y := Y1;
  91.     if X1 > X2 then begin Temp := X1; X1 := X2; X2 := Temp; end;
  92.     if Y1 > Y2 then begin Temp := Y1; Y1 := Y2; Y2 := Temp; end;
  93.     HotRect := Rect (X1, Y1, X2, Y2);
  94. end;
  95.  
  96. procedure TAntsNest.DrawHotRect;
  97. const
  98.     StartMask: Byte = $80;
  99. begin
  100.     StartMask := StartMask shr 1;
  101.     if StartMask = 0 then StartMask := $80;
  102.     DashMask := StartMask;
  103.  
  104.     with HotRect do begin
  105.         LineDDA (Left, Top, Right, Top, @LineDDAProc, Integer (Self));
  106.         LineDDA (Right, Top, Right, Bottom, @LineDDAProc, Integer (Self));
  107.         LineDDA (Right, Bottom, Left, Bottom, @LineDDAProc, Integer (Self));
  108.         LineDDA (Left, Bottom, Left, Top, @LineDDAProc, Integer (Self));
  109.     end;
  110. end;
  111.  
  112. procedure TAntsNest.Timer1Timer(Sender: TObject);
  113. begin
  114.     DrawHotRect;
  115. end;
  116.  
  117. end.
  118.  
  119.  
  120.